Rental Instability in Louisville
Greater Louisville Project
2020-12-08
Introduction
This recreates the Urban Institute’s Emergency Rental Assistance Priority Index for Louisville. The original index compares Louisville to the rest of Kentucky. At Greater Louisville Project, we think the more appropriate comparison is to our other peer cities. While the maps below show Louisville, the index values are based on a comparison to all census tracts in the core counties of our peer cities.
Greater Louisville Project has also aggregated the data up to the metro council district level. That data is available in both maps and tables.
In addition to the indexes, the indicators that make up the indexes are also mapped below. Navigation is based on tabs, so clicking on the small blue titles brings up the map related to each title.
Methods and Definitions
To produce an index with multiple indicators on different scales we used z-scores, which are a measure of how far away from average an observation is. For example, if looking at unemployment, we start with the unemployment rate in all tracts and the score for an individual tract is the number of standard deviations it is away from the average tract.
Data is from the Urban Institute’s Emergency Rental Assistance Priority Index and in most cases is tract level census data from 2018. The low income jobs lost to Covid is an Urban Institute constructed indicator. Complete details on the indicators can be found in the technical appendix, but they are summarized here for convenience.
Housing Instability Index
- Poverty: Under the poverty line in the last 12 months
- Percent Renting: The percent of households in the area who rent
- Cost Burdened: Households making less than 35,000 and paying more than 50% of their income in rent
- Overcrowding: Households renting and with more than 1.5 people per room.
- Unemployed: In the labor force but not currently employed.
Covid Index
- Health Insurance: Based on the noninstitutionalized population ages 19-64.
- Low Income Job Loss from Covid: Estimated jobs lost to Covid based on previous Urban Institute Study
Equity Index
- Percent Persons of Color: Percent of people in the area who identify as persons of color
- Extremely Low Income: Renter occupied household making less than 30 percent of area median income
- Public Assistance: Percent receiving some form of public assistance like SNAP or TANF
- Foreign Born: Percent born outside the U.S.
library(tidyverse)
library(rgdal)
library(sf)
library(viridis)
library(magrittr)
df <- read_csv("housing_index_raw.csv")
# Filter to just peers
df_peer <- df %>%
filter(county_fips %in% c("1073", "18097", "21111", "26081", "29095", "29189",
"29510", "31055", "37081", "37119", "39049", "39061",
"40109", "40143", "45045", "47037", "47093", "47157")) %>%
select(-contains("z_score"), -contains("index")) #drop index and z_score terms so we can recreate them
# Make z scores
make_z <- function(x){
x <- (x - mean(x)) / sd(x)
}
df_z <- df_peer %>%
mutate(across(where(is.numeric), make_z, .names = "z_{.col}"))
df_index <- df_z %>%
mutate(
housing_instability_index = z_perc_poverty_12mnth * .2 + z_perc_renters * .2 + z_perc_cost_burdened_under_35k * .2 + z_perc_overcrowding_renter_1.50_or_more * .2 + z_perc_unemployed_laborforce * .2,
covid_index = z_perc_no_hinsure * .5 + z_perc_low_income_jobs_lost * .5,
equity_index = z_perc_person_of_color * .5 + z_perc_30hamfi * .167 + z_perc_public_assistance * .167 + z_perc_foreign_born * .167,
overall_index = housing_instability_index * .5 + covid_index * .1 + equity_index * .4
)Rental Insecurity Index
jfco_shp <- readOGR("JC Tracts", layer = "JC Tracts",
GDAL1_integer64_policy = TRUE, verbose = FALSE)
jfco_sf <- st_as_sf(jfco_shp) %>%
mutate(GEOID = str_sub(GEO_ID, start = -11))
jfco_index <- df_index %>%
filter(county_fips == "21111")
# Urban institute includes a greyed out flag for tracts without enough data
# It's easier to set the values to NA because the graphing framework has the ability to easily assign NA a different color
jfco_index <- jfco_index %>%
mutate(across(where(is.numeric), ~if_else(jfco_index$grayed_out == 1, NA_real_, .)))
jfco_sf <- full_join(jfco_sf, jfco_index, by = "GEOID")
# Transform the percents
mult100 <- function(x){
x <- x * 100
}
jfco_sf <- jfco_sf %>%
mutate(across(starts_with("perc_"), mult100))
make_map <- function(indicator, title = "", legend = "", caption = "", no_legend = FALSE){
plt <- ggplot(jfco_sf) +
geom_sf(aes(fill={{ indicator }} )) +
# scale_fill_gradient(low = "#323844", high = "#d63631", name = "Percent") +
scale_fill_viridis(na.value = "grey", name = legend) +
theme_bw() +
theme(panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.border = element_blank()) +
labs(title = title,
caption = caption)
if (no_legend == TRUE){
plt <- plt + theme(legend.position = "none")
}
return(plt)
}
make_map(overall_index, title = "Rental Insecurity Index",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher rental insecurity. \n This is the Urban Institute's Emergency Rental Assistance Priority Index modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
You can flip through the tabs below to see each of the three subindexes that make up the overall rental index.
Housing Instability Subindex
- Share of people living in poverty
- Share of renter-occupied housing units
- Share of severely cost-burdened low-income renters
- Share of severely overcrowded households
- Share of unemployed people
make_map(housing_instability_index, title = "Housing Instability Subindex",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher housing instability. \n This is the Urban Institute's Housing Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
Covid 19 Impact Subindex
- Share of adults without health insurance
- Share of low-income jobs lost to Covid-19
make_map(covid_index, title = "Covid Instability Subindex",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher covid instability. \n This is the Urban Institute's Covid Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
Equity Subindex
- Share of people of color
- Share of extremely low-income renter households
- Share of households receiving public assistance
- Share of people born outside the United States
make_map(equity_index, title = "Equity Subindex",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher prioritization based on equity. \n This is the Urban Institute's Equity subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
Housing Instability Indicators
Poverty
make_map(perc_poverty_12mnth, title = "Poverty",
legend = "Percent",
caption = "Percent of each census tract that is in poverty. \n Data from Urban Institute.")
Percent Renting
make_map(perc_renters, title = "Percent of Renter Occupied Housing Units",
legend = "Percent",
caption = "Percent of each tract that rents. \n Data from Urban Institute")
Cost-burdened housholds
make_map(perc_cost_burdened_under_35k, title = "Costburdened Households making under 35k",
legend = "Percent",
caption = "Percent of households making less than 35,000 and paying more than 50% of their income in rent. \n Data from Urban Institute")
Overcrowding
make_map(perc_overcrowding_renter_1.50_or_more, title = "Overcrowding in Rental Housing",
legend = "Percent",
caption = "Percent of households renting and with more than 1.5 people per room. \n Data from Urban Institute")
Unemployed
make_map(perc_unemployed_laborforce, title = "Unemployment",
legend = "Percent",
caption = "Percent of people unemployed but still in the labor force (actively seeking work). \n Data from Urban Institute")
Covid Indicators
No Health Insurance
make_map(perc_no_hinsure, title = "No Health Insurance",
legend = "Percent",
caption = "Percent without health insurance. \n Data from Urban Institute")
Low Income Jobs Lost to Covid
make_map(perc_low_income_jobs_lost, title = "Low Income Jobs Lost to Covid",
legend = "Percent",
caption = "Estimate from the Urban Institute based on job categories in the each tract. \n Data from Urban Institute")
Equity Index
Percent PoC
make_map(perc_person_of_color, title = "Percent Persons of Color",
legend = "Percent",
caption = "Percent of persons in the area who identify as persons of color. \n Data from Urban Institute")
Extremely Low Income
make_map(perc_30hamfi, title = "Extremely Low Income",
legend = "Percent",
caption = "Renter occupied household making less than 30 percent of area median income. \n Data from Urban Institute")
Public Assistance
make_map(perc_public_assistance, title = "Recieving Public Assistance",
legend = "Percent",
caption = "Percent receiving some form of public assistance like SNAP or TANF. \n Data from Urban Institute")
Foreign Born
make_map(perc_foreign_born, title = "Foreign Born",
legend = "Percent",
caption = "Percent born outside the U.S. \n Data from Urban Institute")
Peer City Data
Peer city data is available for the housing stability subindex.
# set up fonts
library(showtext)
showtext_auto()
font_add("Montserrat", "Montserrat/Montserrat-Regular.ttf")
font_add("Montserrat Bold", "Montserrat/Montserrat-SemiBold.ttf")
# Ranking graph function
ranking <- function(df, var, plot_title = "",
year = NULL, sex = "total", race = "total",
order = "Descending",
y_title = "Percent", caption_text = "", subtitle_text = "",
bar_label = TRUE, sigfig = 3, accuracy = 0.1,
label_function, alternate_text = NULL,
ranking_colors = TRUE, text_size){
# Copy variable var to a new column for use with the '$' operator
var <- dplyr:::tbl_at_vars(df, vars(!!enquo(var)))
df$var <- df[[var]]
# Filter to sex, race, and year
if ("sex" %in% names(df)) df <- df[df$sex == sex,]
if ("race" %in% names(df)) df <- df[df$race == race,]
if("year" %in% names(df)) {
if (is.null(year)) year <- max(years_in_df(df, var))
df <- df[df$year %in% year,]
if (length(year) > 1) {
df %<>%
group_by_at(df %cols_in% c("MSA", "FIPS")) %>%
summarise(var = mean(var, na.rm = TRUE)) %>%
ungroup()
}
}
# Add peer data if not already present
# if (df_type(df) %in% c("FIPS", "MSA") & "current" %not_in% names(df)) df %<>% pull_peers(add_info = T)
# Sort according to order parameter
if (order %in% c("descending", "Descending")) df %<>% arrange(desc(var))
if (order %in% c("ascending", "Ascending")) df %<>% arrange(var)
df %<>% filter(!is.na(var))
# Create numbered city labels for left side of graph
df %<>%
mutate(
rank = row_number(),
names = paste0(rank, ". ", city))
# Set bar colors
if (ranking_colors) {
# color_values <- c("#96ca4f", "#ffd600", "#db2834")
# color_names <- c("green", "yellow", "red")
# if (order %in% c("descending", "Descending")) {color_names = rev(color_names)}
#
# breaks <- classInt::classIntervals(na.omit(df$var), 3, style = "jenks")
# df$color <- NA
# df$color[df$var <= breaks$brks[2]] <- color_names[1]
# df$color[df$var > breaks$brks[2] & df$var <= breaks$brks[3]] <- color_names[2]
# df$color[df$var > breaks$brks[3]] <- color_names[3]
color_values <- c("#d63631", "#323844")
color_names <- c("gray", "red")
df$color <- "red"
df$color[df$city == "Louisville"] <- "gray"
} else {
df$color <- "blue"
color_values <- "#f58021"
color_names <- "blue"
}
if (order %in% c("descending", "Descending")) color_values = rev(color_values)
# Create numeric labels
# Create numeric labels
if (!missing(label_function)) {
label_text <- df$var %>% signif(sigfig) %>% label_function()
} else if (y_title == "Dollars") {
if(mean(df$var, na.rm = TRUE) > 10000) {
label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = accuracy, scale = .001, suffix = "k")
} else {
label_text <- df$var %>% signif(sigfig) %>% scales::dollar(accuracy = .01)
}
} else if (stringr::str_detect(y_title, "Percent")) {
label_text <- df$var %>% signif(sigfig) %>% scales::percent(accuracy = accuracy, scale = 1, suffix = "%")
} else {
label_text <- df$var %>% signif(sigfig) %>% scales::comma(accuracy = accuracy)
}
# Set text format, highlight and italicise Louisville text, highlight Louisville bar
df$textcolor <- "#000000"
df$textcolor[df$city == "Louisville"] <- "#000000"
df$textfont <- "Montserrat"
df$textfont[df$city == "Louisville"] <- "Montserrat Bold"
label_color_names <- c("white", "black")
label_color_values <- c("#000000", "#ffffff")
df$label_color <- "white"
df$label_color[df$city == "Louisville"] <- "black"
#df$linecolor <- "#ffffff"
#df$linecolor[df$city == "Louisville"] <- "#00a9b7"
df$lou <- if_else(df$city == "Louisville", 1, 0)
df$text_alignment <- 1.1
if (!is.null(alternate_text)) df$text_alignment[df$rank %in% alternate_text] <- -0.1
### PLOT GRAPH
# Initial plot
p <- ggplot(data = df,
aes(x = factor(names, levels = rev(names)),
y = var,
fill = factor(color, levels = color_names, ordered = TRUE)))
p <- p + guides(fill = FALSE, color = FALSE)
# Add bars
p <- p +
geom_bar(stat = "identity",
size = text_size) +
coord_flip() +
ggthemes::theme_tufte()
p <- p + scale_fill_manual(values = color_values)
#p <- p + scale_color_manual(values = c("#ffffff", "#00a9b7"))
# Add features
title_scale <- min(1, 48 / nchar(plot_title))
p <- p + theme(text = element_text(family = "Montserrat"),
plot.title = element_text(size = 14 * title_scale * text_size, hjust = 0.5, margin = margin(b = 10, unit = "pt")),
axis.text.y = element_text(hjust = 0,
size = 10 * text_size,
color = rev(df$textcolor),
family = rev(df$textfont)),
axis.title.x = element_text(size = 10 * text_size),
axis.ticks = element_blank(),
axis.text.x = element_blank(),
plot.caption = element_text(size = 5 * text_size, lineheight = 0.5))
if(subtitle_text != ""){
p <- p + theme(plot.subtitle = element_text(hjust = 0.5, size = 5 * text_size)) +
labs(subtitle = subtitle_text)
}
# Add numeric labels to bars based on bar_label parameter
if (y_title != "" & bar_label) {
p <- p + geom_text(aes(label = label_text,
hjust = text_alignment,
color = factor(label_color),
family = textfont),
size = 5 * text_size) +
scale_colour_manual(values=c("#000000", "#ffffff"))
}
# Add vertical line to the left side of the bars based on the h_line parameter
if (min(df$var, na.rm = TRUE) < 0) p <- p + geom_hline(yintercept = 0, linetype = "longdash", size = 2)
# Add remaining text
p <- p + labs(title = plot_title, y = y_title,
x = "", caption = caption_text)
p
}Cost Burdened Renters
#Data was pulled in Python file get_data.py and written to .csv
df <- read_csv("low_income_renters.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
# Calculate percent of households making under 35k who pay more than 50% of their
# income on rent
df <- df %>%
# select ACS table variables w/ attached GEOID
select(
NAME,
# These are all the peolpe making under 35k (denominator)
B25074_002E,
B25074_011E,
B25074_020E,
# These are all the people making under 35k who pay more than 50% of their income on rent (numerator)
B25074_009E,
B25074_018E,
B25074_027E,
# These are the people making under 35k for whom this metric wasn't computed
# and they therefore need to be subtracted from the denominator
B25074_010E,
B25074_019E,
B25074_028E
) %>%
#rename both county and city to just St. Louis
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
#use summarize across instead to save space and make reusable in a function
summarize(
B25074_002E = sum(B25074_002E),
B25074_011E = sum(B25074_011E),
B25074_020E = sum(B25074_020E),
B25074_009E = sum(B25074_009E),
B25074_018E = sum(B25074_018E),
B25074_027E = sum(B25074_027E),
B25074_010E = sum(B25074_010E),
B25074_019E = sum(B25074_019E),
B25074_028E = sum(B25074_028E)
) %>%
# create cost burden variable w/ calculation
mutate(
perc_cost_burdened_under_35k = (B25074_009E + B25074_018E + B25074_027E) /
(
B25074_002E + B25074_011E + B25074_020E - B25074_010E - B25074_019E -
B25074_028E
),
#cd add
perc_cost_burdened_under_35k =
if_else(
B25074_002E + B25074_011E + B25074_020E == 0,
0,
perc_cost_burdened_under_35k
)
)
# Clean up for graph
df <- df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_cost_burdened_under_35k = 100 * perc_cost_burdened_under_35k)
plt_cost_burdened <- ranking(df, "perc_cost_burdened_under_35k", text_size = 1, order = "ascending",
plot_title = "Cost Burdened Renters in Households Making Under 35k ")
plt_cost_burdened
Overcrowding
#Data was pulled in Python file get_data.py and written to .csv
oc_df <- read_csv("overcrowding.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
oc_df <- oc_df %>%
# select ACS table variables w/ attached GEOID
select(NAME, B25014_013E, B25014_012E, B25014_008E) %>%
#rename both county and city to just St. Louis
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
summarize(across(where(is.numeric), sum)) %>%
# create cost burden variable w/ calculation
mutate(perc_overcrowding_renter_1.50_or_more = ((B25014_012E + B25014_013E) / B25014_008E),
perc_overcrowding_renter_1.50_or_more =
if_else(B25014_008E == 0, 0, perc_overcrowding_renter_1.50_or_more))
# Clean up for graph
oc_df <- oc_df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_overcrowding_renter_1.50_or_more = 100 * perc_overcrowding_renter_1.50_or_more)
plt_oc <- ranking(oc_df, "perc_overcrowding_renter_1.50_or_more", text_size = 1, order = "ascending",
plot_title = "Overcrowding")
plt_oc
Unemployment
#Data was pulled in Python file get_data.py and written to .csv
un_df <- read_csv("unemployed.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
un_df <- un_df %>%
# select ACS table variables w/ attached GEOID
select(B12006_055E, B12006_050E, B12006_011E, B12006_006E, B12006_022E, B12006_017E, B12006_033E, B12006_028E, B12006_044E, B12006_039E, B12006_053E, B12006_048E, B12006_009E, B12006_004E, B12006_020E, B12006_015E, B12006_031E, B12006_026E, B12006_042E, B12006_037E, NAME) %>%
# collapse St. Louis into one
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
summarize(across(where(is.numeric), sum)) %>%
# create unemployed variable w/ calculation
mutate(perc_unemployed_laborforce = ((B12006_055E + B12006_050E + B12006_011E + B12006_006E + B12006_022E + B12006_017E + B12006_033E + B12006_028E + B12006_044E + B12006_039E) / (B12006_053E + B12006_048E + B12006_009E + B12006_004E + B12006_020E + B12006_015E + B12006_031E + B12006_026E + B12006_042E + B12006_037E)),
perc_unemployed_laborforce =
if_else(B12006_053E + B12006_048E + B12006_009E + B12006_004E + B12006_020E + B12006_015E + B12006_031E + B12006_026E + B12006_042E + B12006_037E == 0, 0,
perc_unemployed_laborforce))
# Clean up for graph
un_df <- un_df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_unemployed_laborforce = 100 * perc_unemployed_laborforce)
plt_un <- ranking(un_df, "perc_unemployed_laborforce", text_size = 1, order = "ascending",
plot_title = "Unemployed")
plt_un
Share renting
#Data was pulled in Python file get_data.py and written to .csv
sr_df <- read_csv("share_renting.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
sr_df <- sr_df %>%
# select ACS table variables w/ attached GEOID
select(B25003_003E, B25003_001E, NAME) %>%
# collapse St. Louis into one
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
summarize(across(where(is.numeric), sum)) %>%
# create perc_renters variable w/ calculation
mutate(perc_renters = (B25003_003E / B25003_001E),
perc_renters = if_else(B25003_001E == 0, 0, perc_renters),
num_renters = B25003_003E)
# Clean up for graph
sr_df <- sr_df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_renters = 100 * perc_renters)
plt_sr <- ranking(sr_df, "perc_renters", text_size = 1, order = "ascending",
plot_title = "Percent Renters")
plt_sr
Poverty
#Data was pulled in Python file get_data.py and written to .csv
pv_df <- read_csv("poverty.csv")
## This code is modified from the urban institute: https://github.com/UrbanInstitute/covid-rental-risk-index/blob/master/scripts/01_generate_index_variables.R
pv_df <- pv_df %>%
# select ACS table variables w/ attached GEOID
select(C17002_002E, C17002_003E, C17002_001E, NAME) %>%
# collapse St. Louis into one
mutate(NAME = if_else(str_detect(NAME, "St. Louis"), "St. Louis", NAME)) %>%
group_by(NAME) %>%
summarize(across(where(is.numeric), sum)) %>%
# create poverty variable w/ calculation
mutate(perc_poverty_12mnth = ((C17002_002E + C17002_003E) / C17002_001E),
perc_poverty_12mnth =
if_else(C17002_001E == 0, 0, perc_poverty_12mnth))
# Clean up for graph
pv_df <- pv_df %>%
mutate(city = recode(NAME,
`Davidson County, Tennessee` = "Nashville",
`Douglas County, Nebraska` = "Omaha",
`Franklin County, Ohio` = "Columbus",
`Greenville County, South Carolina` = "Greenville",
`Guilford County, North Carolina` = "Greensboro",
`Hamilton County, Ohio` = "Cincinnati",
`Jackson County, Missouri` = "Kansas City",
`Jefferson County, Alabama` = "Birmingham",
`Jefferson County, Kentucky` = "Louisville",
`Kent County, Michigan` = "Grand Rapids",
`Knox County, Tennessee` = "Knoxville",
`Marion County, Indiana` = "Indianapolis",
`Mecklenburg County, North Carolina` = "Charlotte",
`Oklahoma County, Oklahoma` = "Oklahoma City",
`Shelby County, Tennessee` = "Memphis",
`Tulsa County, Oklahoma` = "Tulsa"),
perc_poverty_12mnth = 100 * perc_poverty_12mnth)
plt_pv <- ranking(pv_df, "perc_poverty_12mnth", text_size = 1, order = "ascending",
plot_title = "Poverty")
plt_pv
Metro Council District Maps
Rental Insecurity Index
# Read in cross walk
tract_to_district <- read_csv("district_tract_crosswalk.csv") %>%
mutate(tract = as.character(tract))
# Join to data
district_level <- df_index %>%
rename(tract = GEOID) %>%
# Remove airport to avoid dividing by zero
filter(tract!= "21111980100") %>%
# join crosswalk data to dataframe
left_join(tract_to_district, by = "tract") %>%
# Group by district
group_by(district) %>%
# join crosswalk data to dataframe
summarise(across(where(is.numeric), ~sum(. * total)), .groups = "drop")
# Shape files
metro_shp <- readOGR("Council_Districts", layer = "council_districts",
GDAL1_integer64_policy = TRUE, verbose = FALSE)
metro_sf <- st_as_sf(metro_shp) %>%
rename(district = coundist)
metro_sf <- full_join(metro_sf, district_level, by = "district")
# Transform the percents
mult100 <- function(x){
x <- x * 100
}
# Replicate binary decision tree to determine most-interior point of polygons
# This runs well enough for me, but nothing appears when I try using it in the code below
buffers <- c()
for(d in 1:26) {
buff_max = -0.06
buff_min = 0
this_buffer = buff_min
this_step = buff_max
current_resolution = 11
while(current_resolution > 10){
#browser()
# Buffer inside the polygon using this_buffer
temp_sf <- st_buffer(metro_sf[d,], dist = this_buffer, singleSide = T)
# Calculate area of polygon
temp_area = st_area(temp_sf) %>% as.numeric()
# If remaining area > 0, enlarge buffer by going away from 0.
# Also record most recent correct buffer and area produced by buffer.
# If remaining area is 0, reduce buffer by going toward 0.
if (temp_area > 0) {
current_result = this_buffer
current_resolution = temp_area
this_buffer = this_buffer + this_step
} else {
this_buffer = this_buffer - this_step
}
# Cut search step in half
this_step = this_step / 2
}
buffers <- c(buffers, current_result)
}
metro_sf <- metro_sf %>%
mutate(across(starts_with("perc_"), mult100))
metro_map <- function(indicator, title = "", legend = "", caption = "", no_legend = FALSE){
plt <- ggplot(metro_sf) +
geom_sf(aes(fill={{ indicator }} )) +
# Add District labels
geom_sf_text(aes(label = district), color = "white") +
#geom_sf_text(aes(label = district), family = "Montserrat Bold", fontface = "bold", size = 6, color = "#ffffff",
# fun.geometry = function(x) st_buffer(x, dist = buffers, singleSide = T) %>% st_point_on_surface()) +
# scale_fill_gradient(low = "#323844", high = "#d63631", name = legend) +
scale_fill_viridis(na.value = "grey", name = legend) +
theme_bw() +
theme(panel.grid = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
panel.border = element_blank()) +
labs(title = title,
caption = caption)
if (no_legend == TRUE){
plt <- plt + theme(legend.position = "none")
}
return(plt)
}
metro_map(overall_index, title = "Rental Insecurity Index",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher rental insecurity. \n This is the Urban Institute's Emergency Rental Assistance Priority Index modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
Housing Instability Subindex
metro_map(housing_instability_index, title = "Housing Instability Subindex",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher housing instability. \n This is the Urban Institute's Housing Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
Covid 19 Impact Subindex
metro_map(covid_index, title = "Covid Instability Subindex",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher covid instability. \n This is the Urban Institute's Covid Instability subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
Equity Subindex
metro_map(equity_index, title = "Equity Subindex",
legend = "Compared to \n other tracts",
caption = "Lighter shades indicate higher prioritization based on equity. \n This is the Urban Institute's Equity subindex modified \nto compare Louisville to its peer cities (instead of to other areas in Kentucky). \n Greyed out areas had insufficient data for the index",
no_legend = TRUE)
Poverty
metro_map(perc_poverty_12mnth, title = "Poverty",
legend = "Percent",
caption = "Percent of each census tract that is in poverty. \n Data from Urban Institute.")
Percent Renting
metro_map(perc_renters, title = "Percent of Renter Occupied Housing Units",
legend = "Percent",
caption = "Percent of each tract that rents. \n Data from Urban Institute")
Cost-burdened housholds
metro_map(perc_cost_burdened_under_35k, title = "Costburdened Households making under 35k",
legend = "Percent",
caption = "Percent of households making less than 35,000 and paying more than 50% of their income in rent. \n Data from Urban Institute")
Overcrowding
metro_map(perc_overcrowding_renter_1.50_or_more, title = "Overcrowding in Rental Housing",
legend = "Percent",
caption = "Percent of households renting and with more than 1.5 people per room. \n Data from Urban Institute")
Unemployed
metro_map(perc_unemployed_laborforce, title = "Unemployment",
legend = "Percent",
caption = "Percent of people unemployed but still in the labor force (actively seeking work). \n Data from Urban Institute")
No Health Insurance
metro_map(perc_no_hinsure, title = "No Health Insurance",
legend = "Percent",
caption = "Percent without health insurance. \n Data from Urban Institute")
Low Income Jobs Lost to Covid
metro_map(perc_low_income_jobs_lost, title = "Low Income Jobs Lost to Covid",
legend = "Percent",
caption = "Estimate from the Urban Institute based on job categories in the each tract. \n Data from Urban Institute")
Percent PoC
metro_map(perc_person_of_color, title = "Percent Persons of Color",
legend = "Percent",
caption = "Percent of persons in the area who identify as persons of color. \n Data from Urban Institute")
Extremely Low Income
metro_map(perc_30hamfi, title = "Extremely Low Income",
legend = "Percent",
caption = "Renter occupied household making less than 30 percent of area median income. \n Data from Urban Institute")
Public Assistance
metro_map(perc_public_assistance, title = "Recieving Public Assistance",
legend = "Percent",
caption = "Percent receiving some form of public assistance like SNAP or TANF. \n Data from Urban Institute")
Foreign Born
metro_map(perc_foreign_born, title = "Foreign Born",
legend = "Percent",
caption = "Percent born outside the U.S. \n Data from Urban Institute")
Metro Council Tables
Housing Subindex
library(gt)
metro_house_tbl <- metro_sf %>%
st_drop_geometry() %>%
filter(!is.na(district)) %>%
select(district, perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more, housing_instability_index) %>%
#GT fmt_percent expects percents as decimals
mutate(across(starts_with("perc"), ~ ./100)) %>%
gt() %>%
tab_header(title = "Table 1: Housing Indicators",
subtitle = "Components of the Housing Instability Subindex") %>%
fmt_number(columns = vars(housing_instability_index),
n_sigfig = 2,
suffixing = TRUE) %>%
fmt_percent(columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more),
decimals = 0) %>%
cols_label(district = "Metro District",
perc_cost_burdened_under_35k = "Cost Burdened",
perc_renters = "Renting",
perc_poverty_12mnth = "Poverty",
perc_unemployed_laborforce = "Unemployed",
perc_overcrowding_renter_1.50_or_more = "Overcrowding",
housing_instability_index = "Index") %>%
cols_move(columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more, housing_instability_index),
after = vars(district)) %>%
tab_spanner(
label = "Index",
columns = vars(housing_instability_index)
) %>%
tab_spanner(
label = "Percent",
columns = vars(perc_cost_burdened_under_35k, perc_renters, perc_poverty_12mnth, perc_unemployed_laborforce, perc_overcrowding_renter_1.50_or_more)
) %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Greater Louisville Project")
) %>%
tab_source_note(
source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)
)
metro_house_tbl| Table 1: Housing Indicators | ||||||
|---|---|---|---|---|---|---|
| Components of the Housing Instability Subindex | ||||||
| Metro District | Percent | Index | ||||
| Cost Burdened | Renting | Poverty | Unemployed | Overcrowding | Index | |
| 1 | 47% | 45% | 24% | 12% | 0% | 0.22 |
| 2 | 51% | 50% | 20% | 8% | 3% | 0.33 |
| 3 | 46% | 47% | 26% | 10% | 1% | 0.27 |
| 4 | 35% | 80% | 43% | 17% | 1% | 0.97 |
| 5 | 47% | 57% | 34% | 17% | 1% | 0.73 |
| 6 | 40% | 77% | 43% | 11% | 1% | 0.75 |
| 7 | 64% | 27% | 6% | 3% | 0% | −0.35 |
| 8 | 38% | 32% | 9% | 3% | 1% | −0.46 |
| 9 | 41% | 42% | 10% | 4% | 0% | −0.36 |
| 10 | 47% | 41% | 15% | 6% | 0% | −0.15 |
| 11 | 32% | 29% | 7% | 4% | 1% | −0.49 |
| 12 | 49% | 32% | 12% | 6% | 2% | −0.16 |
| 13 | 35% | 39% | 17% | 6% | 1% | −0.21 |
| 14 | 50% | 23% | 16% | 5% | 0% | −0.32 |
| 15 | 41% | 55% | 26% | 9% | 1% | 0.28 |
| 16 | 66% | 19% | 5% | 4% | 1% | −0.32 |
| 17 | 64% | 26% | 7% | 3% | 1% | −0.31 |
| 18 | 56% | 37% | 5% | 3% | 1% | −0.29 |
| 19 | 70% | 21% | 4% | 4% | 1% | −0.29 |
| 20 | 47% | 17% | 4% | 3% | 1% | −0.57 |
| 21 | 50% | 49% | 22% | 6% | 1% | 0.077 |
| 22 | 36% | 21% | 6% | 3% | 2% | −0.51 |
| 23 | 41% | 19% | 6% | 4% | 1% | −0.52 |
| 24 | 48% | 37% | 14% | 5% | 1% | −0.12 |
| 25 | 34% | 34% | 11% | 5% | 1% | −0.39 |
| 26 | 52% | 40% | 12% | 4% | 1% | −0.18 |
| Greater Louisville Project | ||||||
| Metro Council Districts are estimated from tract level data. Data is from the Urban Institute. | ||||||
Covid Subindex
metro_covid_tbl <- metro_sf %>%
st_drop_geometry() %>%
filter(!is.na(district)) %>%
select(district, perc_no_hinsure, perc_low_income_jobs_lost, covid_index) %>%
#GT fmt_percent expects percents as decimals
mutate(across(starts_with("perc"), ~ ./100)) %>%
gt() %>%
tab_header(title = "Table 2: Covid Indicators",
subtitle = "Components of the Covid Subindex") %>%
fmt_number(columns = vars(covid_index),
n_sigfig = 2,
suffixing = TRUE) %>%
fmt_percent(columns = vars(perc_no_hinsure, perc_low_income_jobs_lost),
decimals = 0) %>%
cols_label(district = "Metro District",
perc_no_hinsure = "No Health Insurance",
perc_low_income_jobs_lost = "Covid Job Loss",
covid_index = "Covid Index") %>%
cols_move(columns = vars(perc_no_hinsure, perc_low_income_jobs_lost, covid_index),
after = vars(district)) %>%
tab_spanner(
label = "Index",
columns = vars(covid_index)
) %>%
tab_spanner(
label = "Percent",
columns = vars(perc_no_hinsure, perc_low_income_jobs_lost)
) %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Greater Louisville Project")
) %>%
tab_source_note(
source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)
)
metro_covid_tbl| Table 2: Covid Indicators | |||
|---|---|---|---|
| Components of the Covid Subindex | |||
| Metro District | Percent | Index | |
| No Health Insurance | Covid Job Loss | Covid Index | |
| 1 | 9% | 9% | −0.18 |
| 2 | 14% | 8% | −0.012 |
| 3 | 10% | 9% | −0.098 |
| 4 | 10% | 10% | −0.011 |
| 5 | 10% | 9% | −0.082 |
| 6 | 11% | 9% | 0.0010 |
| 7 | 6% | 9% | −0.20 |
| 8 | 4% | 9% | −0.34 |
| 9 | 7% | 9% | −0.22 |
| 10 | 9% | 9% | −0.20 |
| 11 | 5% | 9% | −0.41 |
| 12 | 7% | 8% | −0.42 |
| 13 | 13% | 8% | −0.17 |
| 14 | 8% | 8% | −0.42 |
| 15 | 12% | 9% | −0.046 |
| 16 | 4% | 10% | −0.24 |
| 17 | 5% | 10% | −0.16 |
| 18 | 5% | 9% | −0.28 |
| 19 | 3% | 9% | −0.36 |
| 20 | 3% | 8% | −0.49 |
| 21 | 14% | 8% | −0.017 |
| 22 | 5% | 8% | −0.44 |
| 23 | 7% | 8% | −0.38 |
| 24 | 9% | 8% | −0.29 |
| 25 | 8% | 8% | −0.38 |
| 26 | 9% | 9% | −0.17 |
| Greater Louisville Project | |||
| Metro Council Districts are estimated from tract level data. Data is from the Urban Institute. | |||
Equity Index
metro_equity_tbl <- metro_sf %>%
st_drop_geometry() %>%
filter(!is.na(district)) %>%
select(district, perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index) %>%
#GT fmt_percent expects percents as decimals
mutate(across(starts_with("perc"), ~ ./100)) %>%
gt() %>%
tab_header(title = "Table 3: Equity Indicators",
subtitle = "Components of the Equity Subindex") %>%
fmt_number(columns = vars(equity_index),
n_sigfig = 2,
suffixing = TRUE) %>%
fmt_percent(columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born),
decimals = 0) %>%
cols_label(district = "Metro District",
perc_person_of_color = "Person of Color",
perc_30hamfi = "Extremely Low Income",
perc_public_assistance = "Public Assistance",
perc_foreign_born = "Foreign Born",
equity_index = "Index") %>%
cols_move(columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index),
after = vars(district)) %>%
tab_spanner(
label = "Index",
columns = vars(equity_index)
) %>%
tab_spanner(
label = "Percent",
columns = vars(perc_person_of_color, perc_30hamfi, perc_public_assistance, perc_foreign_born, equity_index)
) %>%
cols_align(align = "center") %>%
tab_source_note(
source_note = md("Greater Louisville Project")
) %>%
tab_source_note(
source_note = md("Metro Council Districts are estimated from tract level data. Data is from the Urban Institute.")
) %>%
opt_row_striping(row_striping = TRUE) %>%
opt_table_outline() %>%
tab_options(
table.font.size = px(12),
table.width = pct(50)
)
metro_equity_tbl| Table 3: Equity Indicators | |||||
|---|---|---|---|---|---|
| Components of the Equity Subindex | |||||
| Metro District | Percent | ||||
| Person of Color | Extremely Low Income | Public Assistance | Foreign Born | Index | |
| 1 | 68% | 43% | 2% | 2% | 0.48 |
| 2 | 69% | 28% | 2% | 18% | 0.67 |
| 3 | 66% | 45% | 4% | 4% | 0.57 |
| 4 | 60% | 50% | 4% | 4% | 0.53 |
| 5 | 74% | 45% | 3% | 1% | 0.63 |
| 6 | 53% | 46% | 3% | 5% | 0.38 |
| 7 | 16% | 11% | 1% | 7% | −0.71 |
| 8 | 7% | 15% | 1% | 3% | −0.92 |
| 9 | 15% | 19% | 2% | 5% | −0.67 |
| 10 | 28% | 28% | 2% | 9% | −0.28 |
| 11 | 23% | 11% | 2% | 8% | −0.53 |
| 12 | 27% | 26% | 3% | 5% | −0.32 |
| 13 | 31% | 23% | 5% | 12% | −0.035 |
| 14 | 15% | 28% | 4% | 3% | −0.51 |
| 15 | 38% | 32% | 5% | 8% | 0.11 |
| 16 | 18% | 8% | 1% | 8% | −0.67 |
| 17 | 25% | 15% | 2% | 10% | −0.43 |
| 18 | 20% | 12% | 1% | 11% | −0.57 |
| 19 | 17% | 14% | 1% | 6% | −0.71 |
| 20 | 16% | 17% | 1% | 4% | −0.74 |
| 21 | 44% | 29% | 2% | 19% | 0.28 |
| 22 | 22% | 13% | 1% | 5% | −0.63 |
| 23 | 23% | 16% | 2% | 6% | −0.54 |
| 24 | 31% | 26% | 3% | 11% | −0.13 |
| 25 | 24% | 20% | 2% | 6% | −0.49 |
| 26 | 26% | 20% | 4% | 13% | −0.19 |
| Greater Louisville Project | |||||
| Metro Council Districts are estimated from tract level data. Data is from the Urban Institute. | |||||